home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hardcore Visual Basic 5.0 (2nd Edition)
/
Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso
/
Code
/
split.cls
< prev
next >
Wrap
Text File
|
1997-06-14
|
15KB
|
446 lines
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "CSplitter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
' Thanks to Elliott Whitticar and Vadim Katsman who fixed bugs and suggested
' improvements to my CHSplitter and CVSplitter classes. I integrated some of
' their code, but didn't solve all possible splitter problems. The primary
' improvement (implemented separately by both Elliot and Vadim) is combining
' vertical and horizontal splitters into a single class. Thanks.
' Internal variables for forms and controls
Private ctlNW As Object ' Left/Top control
Private ctlSE As Object ' Right/Bottom control
Private objContainer As Object
' Sizes of borders and pixels
Private xySplit As Single ' Position of splitter bar
Private dxySplit As Single ' Width/height of splitter bar in scale units
Private dxyMin As Single ' Minimum control width/height
Private xPixel As Single
Private yPixel As Single
Private dxBorder As Single
Private dyBorder As Single
Private cBorderPixels As Long
' Flags
Private fResize As Boolean ' True ==> move left and right control
Private fAutoBorder As Boolean
Private fDragging As Boolean
Private fCreated As Boolean
Private fVertical As Boolean ' True => Vertical splitter, F => Horizontal
Private iPercent As Integer ' 1 to 99 gives initial split Percent
' Old mouse pointer, draw style, and draw mode
Private mpOld As Integer
Private dsOld As Integer
Private dmOld As Integer
Private mpResize As Integer ' MousePointer to use when resizing
' AutoRedraw
Private arOld As Boolean
Public Enum EErrorSplitter
eeBaseSplitter = 13690 ' CSplitter
eeInvalidControl ' Invalid controls or container
eeSplitNotCreated ' Create splitter before using members
End Enum
#If fComponent = 0 Then
Private Sub ErrRaise(e As Long)
Dim sText As String, sSource As String
If e > 1000 Then
sSource = App.EXEName & ".CSplitter"
Select Case e
Case eeBaseAbout
BugAssert True
Case eeInvalidControl
sText = "Create: Invalid controls or container"
Case eeSplitNotCreated
sText = "Create splitter before using members"
End Select
Err.Raise COMError(e), sSource, sText
Else
' Raise standard Visual Basic error
Err.Raise e, sSource
End If
End Sub
#End If
' Create a splitter window
Sub Create(LeftControl As Object, RightControl As Object, _
Vertical As Boolean, _
Optional BorderPixels As Long = 0, _
Optional AutoBorder As Boolean = True, _
Optional Resizeable As Boolean = True, _
Optional Percent As Integer = 50, _
Optional Cursor As Picture)
fCreated = False
On Error GoTo CreateError
' Set internal controls
Set ctlNW = LeftControl
Set ctlSE = RightControl
Set objContainer = ctlNW.Container
BugAssert objContainer Is ctlSE.Container
' Splitters work--sort of--with ClipControls True, but the splitter line
' isn't drawn correctly, so we disallow it in debug version (go ahead
' and ignore in release if you really want)
BugAssert objContainer.ClipControls = False
' Save resizable and AutoBorder flags
fAutoBorder = AutoBorder
fResize = Resizeable
fVertical = Vertical
' Handle split percent
iPercent = Percent
If iPercent > 99 Then iPercent = 99
If iPercent < 1 Then iPercent = 1
' Set splitter size
cBorderPixels = BorderPixels
If cBorderPixels = 0 Then
fAutoBorder = True
cBorderPixels = 4
End If
With objContainer
' Size of one in pixel in current scale
xPixel = .ScaleX(1, vbPixels, .ScaleMode)
yPixel = .ScaleY(1, vbPixels, .ScaleMode)
' Set cursor
If Cursor Is Nothing Then
If fVertical Then
Set .MouseIcon = LoadResPicture("VSplit", vbResCursor)
Else
Set .MouseIcon = LoadResPicture("HSplit", vbResCursor)
End If
Else
Set .MouseIcon = Cursor
End If
' Get the .MousePointer value to use when resizing
If .MouseIcon.Type = vbPicTypeIcon Then
mpResize = vbCustom
ElseIf fVertical Then
mpResize = vbSizeWE
Else
mpResize = vbSizeNS
End If
' Set border size
If fAutoBorder Then
dxBorder = ctlNW.Left
dyBorder = ctlNW.Top
Else
dxBorder = cBorderPixels * xPixel
dyBorder = cBorderPixels * yPixel
End If
' Set the splitter bar and minimum width/height in scale units
' (Ideally we'd use control properties for minimum width/height)
If fVertical Then
dxySplit = cBorderPixels * xPixel
dxyMin = 20 * xPixel + 2 * dyBorder
Else
dxySplit = cBorderPixels * yPixel
dxyMin = 20 * yPixel + 2 * dyBorder
End If
SplitPercent = Percent
End With
fCreated = True
Exit Sub
CreateError:
ErrRaise eeInvalidControl
End Sub
Property Get Capture() As Boolean
If Not fCreated Then ErrRaise eeSplitNotCreated
' See if the container form or control has captured mouse events
Capture = (GetCapture = objContainer.hWnd)
End Property
Property Let Capture(fCapture As Boolean)
If Not fCreated Then ErrRaise eeSplitNotCreated
' Capture or release mouse events
If fCapture Then
SetCapture objContainer.hWnd
Else
ReleaseCapture
End If
End Property
Private Sub Draw(ByVal xyDraw As Single, _
Optional xyNew As Single = -1#)
With objContainer
' Draw the splitter bar at the specified position
' The second argument is provided so MouseMove can invert the
' old drawing at xyDraw and draw a new splitter bar at xyNew
.DrawStyle = vbInsideSolid
.DrawMode = vbInvert
If fVertical Then
' Erase old line
objContainer.Line (xyDraw - xPixel, ctlNW.Top)-(xyDraw + xPixel, yBottom(ctlNW)), , B
If Not IsMissing(xyNew) Then
' Draw new line
xyDraw = xyNew
objContainer.Line (xyDraw - xPixel, ctlNW.Top)-(xyDraw + xPixel, yBottom(ctlNW)), , B
End If
Else
' Erase old line
objContainer.Line (ctlNW.Left, xyDraw - yPixel)-(xRight(ctlNW), xyDraw + yPixel), , B
If Not IsMissing(xyNew) Then
' Draw new line
xyDraw = xyNew
objContainer.Line (ctlNW.Left, xyDraw - yPixel)-(xRight(ctlNW), xyDraw + yPixel), , B
End If
End If
End With
End Sub
Public Property Get SplitterSize() As Long
' Width/Height of splitter bar in scale units
SplitterSize = dxySplit
End Property
Public Property Get SplitPercent() As Long
With objContainer
If fVertical Then
SplitPercent = 100 / (.ScaleWidth / (xySplit - (dxySplit / 2)))
Else
SplitPercent = 100 / (.ScaleHeight / (xySplit - (dxySplit / 2)))
End If
End With
End Property
Public Property Let SplitPercent(ByVal iPercentCur As Long)
With objContainer
Dim iMinPercent As Long
If fVertical Then
iMinPercent = 100 / (.ScaleWidth / (dxyMin - (dxySplit / 2)))
If iPercentCur < iMinPercent Then iPercentCur = iMinPercent
If iPercentCur > 100 - iMinPercent Then iPercentCur = 100 - iMinPercent
xySplit = ((iPercent / 100) * .ScaleWidth) - (dxySplit / 2)
ctlNW.Move dxBorder, dyBorder, _
xySplit - dxBorder, _
.ScaleHeight - (dyBorder * 2)
ctlSE.Move xRight(ctlNW) + dxySplit, dyBorder, _
.ScaleWidth - ctlNW.Width - (dxBorder * 2), _
ctlNW.Height
Else
iMinPercent = 100 / (.ScaleHeight / (dxyMin - (dxySplit / 2)))
If iPercent < iMinPercent Then iPercent = iMinPercent
If iPercent > 100 - iMinPercent Then iPercent = 100 - iMinPercent
dxySplit = cBorderPixels * yPixel
dxyMin = 20 * yPixel + 2 * dyBorder
xySplit = ((iPercent / 100) * .ScaleHeight) - (dxySplit / 2)
ctlNW.Move dxBorder, dyBorder, _
.ScaleWidth - (dxBorder * 2), _
xySplit - dyBorder
ctlSE.Move dxBorder, yBottom(ctlNW) + dxySplit, _
ctlNW.Width, _
.ScaleHeight - ctlNW.Height - (dyBorder * 2)
End If
End With
End Property
Sub Resize()
With objContainer
Dim rScaleFac As Single
Dim dxyStart As Single, dxyFarEdge As Single
If fVertical Then
rScaleFac = .ScaleWidth / (dxBorder + ctlNW.Width + dxySplit + _
ctlSE.Width + dxBorder)
' Move everything in border size from the edge
dxyFarEdge = .ScaleHeight - dyBorder - dyBorder
ctlNW.Move dxBorder, .ScaleTop + dyBorder, _
ctlNW.Width * rScaleFac, dxyFarEdge
dxyStart = xRight(ctlNW) + dxySplit
ctlSE.Move dxyStart, dyBorder, _
.ScaleWidth - dxyStart - dxBorder, dxyFarEdge
Else ' Resize Horizontal Splitter
rScaleFac = .ScaleHeight / (dyBorder + ctlNW.Height + dxySplit + _
ctlSE.Height + dyBorder)
' Move everything in border size from the edge
dxyFarEdge = .ScaleWidth - dxBorder - dxBorder
ctlNW.Move dxBorder, .ScaleTop + dyBorder, _
dxyFarEdge, ctlNW.Height * rScaleFac
dxyStart = yBottom(ctlNW) + dxySplit
ctlSE.Move dxBorder, dxyStart, dxyFarEdge, _
.ScaleHeight - dxyStart - dyBorder
End If
End With
End Sub
Sub Splitter_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
With objContainer
If Not fCreated Then ErrRaise eeSplitNotCreated
Dim xyNew As Single, xyMinPos As Single, xyMaxPos As Single
Dim fZone As Boolean ' Over Splitter Bar flag
' Change the cursor to splitter or back
' Are we in the container's client area?
If X >= 0 And X <= .ScaleWidth Then
If Y >= .ScaleTop And _
Y <= .ScaleTop + .ScaleHeight Then
' Are we in the splitter bar zone?
If fVertical Then
If X < ctlSE.Left And X > xRight(ctlNW) Then fZone = True
Else
If Y < ctlSE.Top And Y > yBottom(ctlNW) Then fZone = True
End If
End If
End If
If fZone Then ' We're over the splitter bar
If .MousePointer <> mpResize Then
mpOld = .MousePointer
.MousePointer = mpResize
Me.Capture = True
End If
ElseIf (.MousePointer = mpResize) And Not fDragging Then
.MousePointer = mpOld
Me.Capture = False
End If
' Move the splitter line if within range
If fDragging Then
If fVertical Then
xyNew = X
xyMinPos = dxyMin
xyMaxPos = .ScaleWidth - dxyMin
Else ' We're moving the horizontal line
xyNew = Y
xyMinPos = .ScaleTop + dxyMin
xyMaxPos = .ScaleTop + .ScaleHeight - dxyMin
End If
If (xySplit <> xyNew) And _
(xyNew > xyMinPos) And (xyNew < xyMaxPos) Then
' Erase the old line at xySplit and draw the new line
Draw xySplit, xyNew
xySplit = xyNew
End If
End If
End With
End Sub
Sub Splitter_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
With objContainer
If Not fCreated Then ErrRaise eeSplitNotCreated
Dim fZone As Boolean
If fVertical Then
fZone = X > xRight(ctlNW) And X < ctlSE.Left
Else
fZone = Y > yBottom(ctlNW) And Y < ctlSE.Top
End If
' If over splitter start a drag
If fZone Then
If Button = vbLeftButton Then
' Save and restore state
fDragging = True
dsOld = .DrawStyle
dmOld = .DrawMode
arOld = .AutoRedraw
.AutoRedraw = False
' Determine splitter line position
If fVertical Then
xySplit = xRight(ctlNW) + (dxBorder / 3)
Else
xySplit = yBottom(ctlNW) + (dyBorder / 3)
End If
' Draw the splitter line
Draw xySplit
End If
Else
If .MousePointer = mpResize Then .MousePointer = mpOld
End If
End With
End Sub
Sub Splitter_MouseUp(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
With objContainer
If Not fCreated Then ErrRaise eeSplitNotCreated
If fDragging Then
' Erase old line
Draw xySplit
fDragging = False
' Resize the panes if in range
If fVertical Then
If X > dxyMin And X < (.ScaleWidth - dxyMin) Then
ctlNW.Width = X - ctlNW.Left - (dxySplit / 2)
ctlSE.Left = xRight(ctlNW) + dxySplit
ctlSE.Width = .ScaleWidth - ctlSE.Left - dxBorder
End If
Else
If Y > .ScaleTop + dxyMin And Y < (.ScaleTop + .ScaleHeight - dxyMin) Then
ctlNW.Height = Y - ctlNW.Top - (dxySplit / 2)
ctlSE.Top = yBottom(ctlNW) + dxySplit
ctlSE.Height = .ScaleTop + .ScaleHeight - ctlSE.Top - dyBorder
End If
End If
.DrawStyle = dsOld
.DrawMode = dmOld
.AutoRedraw = arOld
End If
' Restore the pointer
If .MousePointer = mpResize Then
.MousePointer = mpOld
Me.Capture = False
End If
End With
End Sub
Sub Splitter_Resize()
If objContainer Is Nothing Then Exit Sub
If Not fCreated Then ErrRaise eeSplitNotCreated
On Error Resume Next
' Only forms have WindowState
If objContainer.WindowState <> vbMinimized And fResize Then Resize
' Must not be form
If Err And fResize Then Resize
End Sub
Private Function xRight(obj As Object) As Single
xRight = obj.Left + obj.Width
End Function
Private Function yBottom(obj As Object) As Single
yBottom = obj.Top + obj.Height
End Function